unit control1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls;

type
CEvent= procedure (sender  :TObject) of object ;
tcontrol1 = class(TCustomControl)
  private
   // constructor Create(AOwner : TComponent); override;
 //   destructor Destroy; override;

   pos_var:Integer;
   max_var:Integer;
  by_user_var:boolean;
   color_var:TColor;
   cliced:Boolean;
    function GetChildWindowAtCoords(Coords: TPoint): HWND;
    // Private declarations }
  protected
    { Protected declarations }
  public
    enable:boolean;
    constructor Create;
        procedure Paint; override;
    procedure setmax(max_:integer);
    procedure setpos(pos_ :integer);
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    function getcursor: Boolean;

    property by_user:boolean read by_user_var ;
    { Public declarations }
  published
   property color:TColor  read color_var write color_var ;
   property pos:integer read pos_var write setpos ;

    { Published declarations }
  end;

procedure Register;

implementation

uses Math;

procedure Register;
begin
  RegisterComponents('Samples', [tcontrol1]);
end;

function tcontrol1.GetChildWindowAtCoords(Coords: TPoint): HWND;
var
  h, hchild: HWND;
begin
  h := WindowFromPoint(Coords);
  if IsWindow(h) then
  begin
    repeat
      hchild := ChildWindowFromPoint(h, Coords);
      if IsWindow(hchild) then
      begin
        if (hchild <> h) then
          h := hchild
        else
          break;
      end
      else
        break;
    until (hchild <> 0);
  end;

  result := h;
end;  // GetChildWindowAtCoords


function tcontrol1.getcursor:Boolean;
begin

  Result:= Self.Handle=GetChildWindowAtCoords(Mouse.CursorPos);
end;

procedure tcontrol1.setmax(max_:integer);
begin
max_var:=max_;

end;
procedure tcontrol1.MouseMove(Shift: TShiftState; X, Y: Integer);
begin

if cliced then

begin
 pos_var:=round((x/Width)*100)    ;
    Paint;
by_user_var:=True;
    end;


end;

procedure tcontrol1.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if cliced then
    begin
 pos_var:=round((x/Width)*100)    ;
    Paint;
   cliced:=False;
   by_user_var:=True;
   end;
end;

procedure tcontrol1.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not enable then exit;
pos_var:=round((x/Width)*100)    ;
    Paint;
     cliced:=True;
     by_user_var:=True;

end;

procedure tcontrol1.setpos(pos_ :integer);
begin
pos_var:=pos_;
   by_user_var:=  false;
Paint;
end;

procedure tcontrol1.Paint;
begin
   inherited;


with Canvas do
begin
Pen.Color:=clBtnShadow;
Brush.Color:=clBtnFace;
FillRect(Self.ClientRect);
Brush.Color:=color_var;
MoveTo(0,0)  ;
LineTo(Width,0);
MoveTo(0,0)  ;
LineTo(0,Height);

Rectangle(0,0,round((pos_var/100)*Width )-1,Height-1);

Pen.Color:=clWhite;
MoveTo(0,Height-1)  ;
LineTo(Width-1,Height-1);
LineTo(Width-1,0);
if pos>0 then
begin
 MoveTo(1,1)  ;
 LineTo(round((pos_var/100)*Width )-2,1);
 MoveTo(1,1)  ;
 LineTo(1,Height-2);
 end;
//  MoveTo(round((pos_var/100)*Width ),1)  ;
// LineTo(,0);

end;

end;

constructor tcontrol1.Create;
begin


end;

end.
